(* #use "topfind";;  *)
(* #require "unix";;  *)
(* #require "libtarotv";;  *)

exception Insoluble

exception Mal_parti

let melanger liste =
  let tab = Array.of_list liste in
  let swap i j = 
    let aux = tab.(i) in
    tab.(i) <- tab.(j) ;
    tab.(j) <- aux
  in
  let place i =
    swap i (Random.int (i + 1))
  in
  for i=1 to -1 + Array.length tab do place i done ;
  Array.to_list tab

let completer_distribution n_cartes interdit =
  (* let () = Printf.printf "Je complète %d cartes...\n%!" n_cartes in *)
  (* let () = Array.iter *)
  (* 	     (fun interdictions -> *)
  (* 	      let () = *)
  (* 		Array.iter (function true -> print_char 'X' *)
  (* 				   | false -> print_char ' ') *)
  (* 			   interdictions *)
  (* 	      in *)
  (* 	      print_newline ()) *)
  (* 	     interdit in *)
  let possibilites =
    let pile_cartes = ref [] in
    let () =
      for i=0 to 77 do
	let pile_pretendants = ref [] in
	let () =
	  for j = 0 to -1 + Array.length interdit do
	    if not interdit.(j).(i) then
	      pile_pretendants :=
		j :: !pile_pretendants
	  done
	in
	if !pile_pretendants <> [] then
	  pile_cartes :=
	    (i, melanger !pile_pretendants)
	    :: (!pile_cartes)
      done
    in
    melanger !pile_cartes
  in
  let (poss_unique, poss_multiples) =
    List.partition (function (_, [_]) -> true
			   | _ -> false) possibilites
  in
  let possibilites = poss_unique @ poss_multiples in
  let solution = Array.make 6 [] in
  let n_restantes = Array.append (Array.make 5 n_cartes) [|3|] in
  let n_echecs = ref 0 in
  (* let indent = ref "" in *)
  let attribuer carte joueur =
    (* let () = Printf.printf "%s%d -> %d\n%!" *)
    (* 			   !indent carte joueur in *)
    (* let () = indent := !indent^"|" in *)
    let () = solution.(joueur) <- carte :: solution.(joueur) in
    n_restantes.(joueur) <- n_restantes.(joueur) - 1
  in
  let desattribuer joueur =
    let () = incr n_echecs in
    (* let () = indent := String.sub !indent 0 (-1 + String.length !indent) in *)
    (* let () = Printf.printf "%sÉchec.\n%!" !indent in *)
    let () = solution.(joueur) <- List.tl (solution.(joueur)) in
    n_restantes.(joueur) <- n_restantes.(joueur) + 1
  in
  let trier_jeu liste =
    List.sort (-)
      liste
  in
  let trier_solution () =
    for i=0 to -1 + Array.length solution do
      solution.(i) <- trier_jeu solution.(i)
    done
  in
  let rec aux = function
    | _ when !n_echecs >= 2000 ->
       raise Mal_parti
    | [] -> true
    | (_, []) :: _ ->
       (* Si je continue, il n'y aura pas assez de cartes ou on n'aura pas distribué une carte exigée *)
       false
    | (carte, pretendant :: autres) :: reste
	 when n_restantes.(pretendant) > 0 ->
       let () = attribuer carte pretendant in
       if aux reste then true
       else
	 let () = desattribuer pretendant in
	 aux ((carte, autres) :: reste)
    | (carte, _ :: autres) :: reste ->
       aux ((carte, autres) :: reste)
  in
  let ok = aux possibilites in
  if not ok then raise (Insoluble)
  else
    let () = trier_solution () in
    solution

(* let donnees = Array.make_matrix 5 78 false *)

(* let () = *)
(*   for i=1 to 30 do (\* 30 cartes jouées - 6 plis - 9 cartes *\) *)
(*     let carte = Random.int 78 in *)
(*     for j=0 to 4 do *)
(*       donnees.(j).(carte) <- true *)
(*     done *)
(*   done *)

(* let () = *)
(*   while true do *)
(*     let sol = completer_distribution 9 donnees in *)
(*     let sol = *)
(*       Array.map *)
(* 	(fun liste -> *)
(* 	 let tab = Array.make 78 true in *)
(* 	 let () = List.iter (fun i -> tab.(i) <- false) liste in *)
(* 	 tab) *)
(* 	sol *)
(*     in *)
(*     let () = *)
(*       print_newline () ; *)
(*       for i=0 to 4 do *)
(* 	for j=0 to 77 do *)
(* 	  match (donnees.(i).(j), sol.(i).(j)) with *)
(* 	  | (true, true) -> print_string "X" *)
(* 	  | (true, false) -> failwith "Échec :(" *)
(* 	  | (false, true) -> print_string " " *)
(* 	  | (false, false) -> print_string "." *)
(* 	done ; *)
(* 	print_newline () *)
(*       done *)
(*     in *)
(*     let () = donnees.(Random.int 5).(Random.int 78) <- true in *)
(*     () *)
(*   done *)
